home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 02 - 1986 / 02.11 Nov 86.sit / 02.11 Nov 86 / Munkki's Forth ok / Sources / Commented Teddy Source next >
Encoding:
Text File  |  1986-09-06  |  24.9 KB  |  809 lines  |  [TEXT/MACA]
  1. ( Teddy -- Text Editor )
  2. ( Contains MacForth-like extensions to Mach I in addition to the editor.
  3.   Type TED to call the editor at any time. The MacForth-style extensions
  4.   are mostly undocumented here. Look for examples in this source. )
  5. ( Anew:
  6.   Used in the form: ANEW PROGRAM_NAME. It tries to find the PROGRAM_NAME
  7.  and forget it if it is found. It then creates PROGRAM_NAME and continues.
  8.  It should be used in the beginning of the program. Old versions are then
  9.  automatically forgotten, if they exist. )
  10. ONLY FORTH DEFINITIONS 
  11. ALSO MAC ALSO ASSEMBLER
  12. : ANEW { | LEN }
  13.   32 WORD DUP C@ 1+ NEGATE -> LEN
  14.   FIND SWAP DROP
  15.    IF LEN >IN +! FORGET CALL DRAWMENUBAR THEN
  16.  LEN >IN +!
  17. CREATE DOES> DROP
  18. ;
  19. ( Heapvar:
  20.   Used in the form: HEAPVAR VARIABLE_NAME. If VARIABLE_NAME exists, it
  21.  returns the handle from VARIABLE_NAME to the heap. It should be used
  22.  before ANEW to free space from the heap. )
  23. : HEAPVAR
  24.   32 WORD
  25.   FIND IF LINK>BODY EXECUTE 
  26.      @ DUP 
  27.      IF DUP CALL HUNLOCK DROP
  28.             CALL DISPOSHANDLE DROP ELSE DROP THEN
  29.      ELSE DROP
  30.    THEN
  31. ;
  32.  
  33. : RECT
  34.  CREATE
  35.  SWAP 2SWAP SWAP
  36.  W, W, W, W,
  37. ;
  38.  
  39. GLOBAL
  40.  CODE !RECT
  41.     MOVE.L    (A6)+,A0
  42.     MOVE.W    14(A6),(A0)+
  43.     MOVE.W    10(A6),(A0)+
  44.     MOVE.W     6(A6),(A0)+
  45.     MOVE.W     2(A6),(A0)+
  46.     ADDA.L    #16,A6
  47.     RTS
  48. END-CODE
  49.  
  50. GLOBAL
  51.  CODE OFF
  52.     MOVEA.L   (A6)+,A0
  53.     CLR.L    (A0)
  54.     RTS
  55. END-CODE
  56. MACH
  57. GLOBAL
  58.  CODE ON
  59.     MOVEA.L   (A6)+,A0
  60.     MOVE.L    #-1,(A0)
  61.     RTS
  62. END-CODE
  63.  
  64. GLOBAL
  65.  CODE SCALE
  66.     MOVE.L   (A6)+,D0
  67.     BMI.S    @1
  68.     MOVE.L   (A6),D1
  69.     ASL.L    D0,D1
  70.     MOVE.L   D1,(A6)
  71.     RTS
  72. @1  MOVE.L   (A6),D1
  73.     NEG.L    D0
  74.     ASR.L    D0,D1
  75.     MOVE.L   D1,(A6)
  76.     RTS
  77. END-CODE
  78. GLOBAL
  79.  CODE @MOUSE
  80.     SUBQ.L    #4,A6
  81.     MOVE.L    A6,-(A7)
  82.     _GETMOUSE
  83.     RTS
  84. END-CODE
  85.  
  86. HEADER TEDDY.W2 DC.L    0
  87. HEADER TEDDY.T2 DC.L    0
  88. HEADER TEDDY.S2 DC.L    0
  89.  CODE CLICKPROC
  90.     MOVEM.L   D1-D3/A0-A4,-(A7)
  91.     CLR.L     -(A7)
  92.     MOVE.L    A7,-(A7)
  93.     _GETMOUSE            ( Where is the mouse cursor? )
  94.     MOVE.L    (A7)+,D0
  95.     SWAP.W    D0         ( Get the Y-location to D0.W  )
  96.     CMP.W     #18,D0     ( Is Mouse.Y smaller than 18? )
  97.     BLT.S     @1
  98.     MOVE.L    TEDDY.W2,A0
  99.     MOVE.W    20(A0),D1
  100.     SUB.W     #16,D1
  101.     CMP.W     D1,D0      ( Is Mouse.Y below the text? )
  102.     BGE.S     @2
  103. @4  MOVEM.L   (A7)+,D1-D3/A0-A4
  104.     MOVEQ.L   #1,D0
  105. @3  RTS
  106.  
  107. @1  CLR.W     -(A7)      ( Are we allowed to scroll down? )
  108.     MOVE.L    TEDDY.S2,-(A7)
  109.     _GETCTLVALUE
  110.     MOVE.W    (A7)+,D0
  111.     BEQ.S     @4         ( If we are on top, do nothing )
  112.     SUBQ.W    #1,D0      ( Scroll one line up )
  113.     MOVE.L    TEDDY.S2,-(A7)
  114.     MOVE.W    D0,-(A7)
  115.     _SETCTLVALUE
  116.     CLR.W     -(A7)
  117.     MOVE.W    #11,-(A7)  ( One line = 11 pixels )
  118.     MOVE.L    TEDDY.T2,-(A7)
  119.     _TESCROLL            ( Scroll the text )
  120.     MOVEM.L   (A7)+,D1-D3/A0-A4
  121.     MOVEQ.L   #1,D0
  122.     RTS
  123.     
  124. @2  CLR.W     -(A7)
  125.     MOVE.L    TEDDY.S2,-(A7)
  126.     _GETCTLVALUE         ( Where are we? )
  127.     MOVE.W    (A7)+,D3
  128.     CLR.W     -(A7)
  129.     MOVE.L    TEDDY.S2,-(A7)
  130.     _GETMAXCTL           ( How high can we go? )
  131.     MOVE.W    (A7)+,D0
  132.     CMP.W     D0,D3
  133.     BGE.S     @4
  134.     ADDQ.W    #1,D3      ( Scroll one line... )
  135.     MOVE.L    TEDDY.S2,-(A7)
  136.     MOVE.W    D3,-(A7)
  137.     _SETCTLVALUE
  138.     CLR.W     -(A7)
  139.     MOVE.W    #-11,-(A7)
  140.     MOVE.L    TEDDY.T2,-(A7)
  141.     _TESCROLL
  142.     MOVEM.L   (A7)+,D1-D3/A0-A4
  143.     MOVEQ.L   #1,D0
  144.     RTS
  145. END-CODE
  146. ( The following routine is quite simple. All it does is search a string
  147.   for another one ignoring case and it returns the offset or a flag. )
  148. CODE FINDER   ( ?STR ?LEN SEARCHSTR SEARCHLEN -- OFFSET )
  149.     MOVEM.L   D0-D7/A0-A4,-(A7)
  150.     MOVE.L    (A6)+,D0
  151.     MOVE.L    (A6)+,A0
  152.     MOVE.L    (A6)+,D1
  153.     MOVE.L    (A6)+,A1
  154.     MOVE.W    D0,D2
  155.     SUB.W     D1,D2
  156.     CLR.L     D7
  157. @1  CLR.W     D3
  158. @2  MOVE.B    0(A0,D3.W),D4
  159.     BMI.S     @3
  160.     CMP.B     #96,D4
  161.     BLT.S     @3
  162.     SUB.B     #32,D4   ( Remove case )
  163. @3  MOVE.B    0(A1,D3.W),D5
  164.     BMI.S     @4
  165.     CMP.B     #96,D5
  166.     BLT.S     @4
  167.     SUB.B     #32,D5   ( Remove case )
  168. @4  CMP.B     D4,D5    ( Is a char equal to another? )
  169.     BNE.S     @5
  170.     ADDQ.W    #1,D3    ( It was, one match )
  171.     CMP.W     D1,D3    ( Have we found the string? )
  172.     BLT.S     @2
  173.     MOVE.L    D7,-(A6)
  174.     MOVEM.L   (A7)+,D0-D7/A0-A4
  175.     RTS
  176.  
  177. @5  ADDQ.L    #1,A0    ( No match...yet )
  178.     ADDQ.L    #1,D7
  179.     DBRA      D2,@1    ( Look again? )
  180.     MOVE.L    #-1,-(A6) ( No match...return -1 )
  181.     MOVEM.L   (A7)+,D0-D7/A0-A4
  182.     RTS
  183. END-CODE
  184. ( 4ASCII nnnn converts the 4 character string into its numeric value it
  185.   can only be used in the immediate mode. Examples below )
  186. : 4ASCII 
  187.  0
  188. 4 0 DO
  189.   8 SCALE 0 WORD 1+ C@ + 
  190. LOOP
  191. ;
  192.  
  193. ONLY FORTH ALSO MAC
  194. 4ASCII TEXT CONSTANT "TEXT
  195. 4ASCII DRVR CONSTANT DRIVER
  196. 4ASCII MACA CONSTANT "MACA
  197.   HEX AB0 CONSTANT TESCRAP.LEN  ( Global TeEdit private scrap variables )
  198.       AB4 CONSTANT TESCRAP.HANDLE DECIMAL
  199.  
  200.  
  201.                    NEW.WINDOW TEDDY.W
  202.                " Text Editor" TEDDY.W TITLE
  203.                  50 0 304 480 TEDDY.W BOUNDS
  204. ZOOM VISIBLE CLOSEBOX GROWBOX TEDDY.W ITEMS
  205.  
  206.             400 4000 TERMINAL TEDDY.TASK
  207.  
  208. NEW.MBAR TEDDY.BAR
  209.  
  210. 900 CONSTANT APPLEID
  211. NEW.MENU APPLEMENU
  212.     HERE 1 C, 20 C, APPLEMENU TITLE
  213. " About Edit...;(-" APPLEMENU ITEMS   ( Add DAs later )
  214.           0 APPLEID APPLEMENU BOUNDS
  215.         
  216.                901 CONSTANT TFILEID
  217.                    NEW.MENU TFILE
  218.                     " File" TFILE TITLE
  219. " Open/O;Save/S;Save as..." TFILE ITEMS
  220.                   0 TFILEID TFILE BOUNDS
  221.  
  222.            902 CONSTANT TEDITID
  223.                NEW.MENU TEDITMENU
  224.                 " Edit" TEDITMENU TITLE
  225. " Cut/X;Copy/C;Paste/V;Select All & Copy;-(;Find/F;Again/G("
  226.                         TEDITMENU ITEMS
  227.               0 TEDITID TEDITMENU BOUNDS
  228.               
  229. : ADD.DRVRS ( Add desk accessories )
  230.  APPLEMENU @ DRIVER CALL ADDRESMENU
  231. ;
  232.  
  233.              NEW.CONTROL TEDDY.SB
  234. VSCROLLBAR VISIBLE 100 0 TEDDY.SB ITEMS
  235.  
  236. : DAHANDLER { ITEM | Daname }
  237.  ITEM 2 > IF                      ( We must open a desk accessory )
  238.      256 CALL NEWPTR -> DANAME    ( Get us a STR255 for the name )
  239.      APPLEMENU @ ITEM DANAME CALL GETITEM
  240.      DANAME CALL OPENDESKACC DROP ( Open the desk accessory )
  241.      DANAME CALL DISPOSPTR        ( Give the String back )
  242.      ELSE
  243.      ITEM 1 = ( The about edit alert should be shown. The resource must
  244.                                          be added separately to Mach I. )
  245.        IF 900 0 CALL ALERT DROP  THEN THEN
  246. ;
  247. HEX  44 CONSTANT txFont ( Offsets in a window record )
  248.      46 CONSTANT txFace
  249.      48 CONSTANT txMode
  250.      4A CONSTANT txSize
  251.      6C CONSTANT WindowKind DECIMAL
  252.  
  253. VARIABLE TEDDY.T     ( PLACEHOLDER FOR TEXT HANDLE )
  254. VARIABLE ACTIVE?     ( ACTIVE FLAG                 )
  255. VARIABLE MUSTCONVERT ( SCRAP CONVERSION FLAG       )
  256.  20 CONSTANT UPARROW ( Part codes )
  257.  21 CONSTANT DOWNARROW
  258.  22 CONSTANT PAGEUP
  259.  23 CONSTANT PAGEDOWN
  260. 129 CONSTANT THUMB
  261.  
  262. VARIABLE CURMAX     ( Current scroll bar range   )
  263. VARIABLE CURSET     ( Current scroll bar setting )
  264. : CORRECT.CONTROL.RANGE
  265.  CURMAX @ TEDDY.T @ @ 94 + W@ 1- 0 MAX DUP CURMAX ! = NOT
  266.   IF TEDDY.SB @ CURMAX @ CALL SETMAXCTL THEN
  267. ;
  268. : CORRECT.CONTROL   ( Set scroll bar )
  269.  CURSET @ ( Look at the destination RECT for the position )
  270.  18 TEDDY.T @ @ W@ L_EXT - 11 / DUP CURSET ! = NOT
  271.  IF TEDDY.SB @ CURSET @ CALL SETCTLVALUE THEN
  272. ;
  273. : TOO.HIGH.TEDDY    ( Autoscroll, when typing )
  274.  0 TEDDY.W 20 + W@ 40 - TEDDY.T @ @ 16 + W@ L_EXT - DUP 11 MOD -
  275.  ?DUP IF ( If tescroll is called with 0 0, the caret disappears! )
  276.  TEDDY.T @ CALL TESCROLL
  277.   ELSE DROP THEN
  278.  CORRECT.CONTROL
  279. ;
  280. : TOO.LOW.TEDDY   ( Autoscroll, when typing )
  281.  0 29 TEDDY.T @ @ 16 + W@ L_EXT - DUP 11 MOD - 
  282.  TEDDY.T @ CALL TESCROLL
  283.  CORRECT.CONTROL
  284. ;
  285. : CORRECTSCROLL ( If the user is typing, check if we should scroll. )
  286.  TEDDY.T @ @ 32 + DUP W@ SWAP 2+ W@ = ( Do we have a caret? )
  287.   IF TEDDY.T @ @ 16 + W@ L_EXT 29 < IF TOO.LOW.TEDDY  ELSE
  288.      TEDDY.T @ @ 16 + W@ L_EXT
  289.      TEDDY.W 20 + W@ 40 - >         IF TOO.HIGH.TEDDY THEN
  290.    THEN
  291.   THEN 
  292. ;
  293. CREATE TEMR 8 ALLOT   ( Temporary storage ) 
  294. : SCRAP->TE           ( Convert global scrap to TeScrap )
  295.  0 "TEXT TEMR CALL GETSCRAP 0>         ( Is there text? )
  296.   IF TESCRAP.HANDLE @ "TEXT TEMR CALL GETSCRAP TESCRAP.LEN W! THEN
  297.   MUSTCONVERT OFF     ( The scrap does not have to be converted just now )
  298. ;
  299. : TE->SCRAP
  300.  MUSTCONVERT @        ( Are there any changes after SCRAP->TE? )
  301.   IF
  302.   CALL ZEROSCRAP DROP ( Zero scrap to clear non-text entries )
  303.   TESCRAP.LEN W@ "TEXT TESCRAP.HANDLE @ @ CALL PUTSCRAP DROP
  304.   THEN
  305. ;
  306. : CLEAR.TESCRAP     ( Word used to clear tescrap when it is not needed )
  307.  TESCRAP.HANDLE @ 0 CALL SETHANDLESIZE DROP
  308.  0 TESCRAP.LEN W!
  309. ;
  310.  
  311. VARIABLE OLDPORT    ( Used to save the current window before a dialog )
  312. CREATE DLOG900 0 ,  ( Handle storage for our "FIND" dialog )
  313. VARIABLE DEVENT     ( Dialog "event" )
  314.  
  315. ( You can se the following strings from Forth and then use "aGain" to
  316.   replace any untypeable characters. Do a find or replace, then set
  317.   teddy.f1 and f2 and choose "aGain". This will do the previous
  318.   operation with the new strings! )
  319. CREATE TEDDY.F1 256 ALLOT ( String to find )
  320. CREATE TEDDY.F2 256 ALLOT ( Replace string )
  321. ( The following part finds Teddy.F1 from the text )
  322. : TFIND.REALLY { | SELEND STRSTART }
  323.  TEDDY.T @ @ 34 + W@    -> SELEND
  324.  TEDDY.T @ @ 62 + @ @   -> STRSTART
  325.  TEDDY.F1 COUNT ?DUP IF 
  326.  STRSTART SELEND +
  327.  TEDDY.T @ @ 60 + W@ SELEND -
  328.  DUP TEDDY.F1 C@ > IF
  329.  FINDER DUP
  330.  0< IF    DROP 10 CALL SYSBEEP 0 0 TEDDY.T @ CALL TESETSELECT
  331.       ELSE
  332.          SELEND + TEDDY.F1 C@ + DUP TEDDY.T @ CALL TESETSELECT
  333.       THEN
  334.  ELSE 2DROP 2DROP 10 CALL SYSBEEP 0 0 TEDDY.T @ CALL TESETSELECT THEN
  335.  CORRECTSCROLL ELSE DROP THEN
  336. ;
  337. ( The following finds Teddy.F1 and replaces it with Teddy.F2 )
  338. : TEDDY.REPLACE { | SELEND STRSTART }
  339.  TEDDY.T @ @ 34 + W@        -> SELEND
  340.  TEDDY.T @ @ 62 + @ @       -> STRSTART
  341.  TEDDY.F1 COUNT ?DUP IF 
  342.  STRSTART SELEND +
  343.  TEDDY.T @ @ 60 + W@ SELEND -
  344.  DUP TEDDY.F1 C@ > IF
  345.  FINDER DUP
  346.  0< IF    DROP 10 CALL SYSBEEP 0 0 TEDDY.T @ CALL TESETSELECT
  347.     ELSE DUP
  348.          SELEND + TEDDY.F1 C@ OVER + TEDDY.T @ CALL TESETSELECT
  349.         TEDDY.T @ CALL TEDELETE
  350.         TEDDY.F2 COUNT TEDDY.T @ CALL TEINSERT
  351.         SELEND + TEDDY.F2 C@ + DUP TEDDY.T @ CALL TESETSELECT
  352.       THEN
  353.  ELSE 2DROP 2DROP 10 CALL SYSBEEP 0 0 TEDDY.T @ CALL TESETSELECT THEN
  354.  CORRECTSCROLL ELSE DROP THEN
  355. ;  
  356. : TEDDYFIND.SUB ( Find or replace according to button )
  357.  DEVENT W@ CASE
  358.   1 OF TFIND.REALLY         ENDOF
  359.   2 OF TEDDY.REPLACE        ENDOF
  360.   ENDCASE
  361. ;
  362. : TEDDYFIND
  363. TE->SCRAP ( Forth receives an activate when the dialog is gone. )
  364.           ( The scrap must be saved to preserve it. )
  365. TEDDY.T @ CALL TEDEACTIVATE
  366. DLOG900 @ 0= IF 900 0 -1  CALL GETNEWDIALOG DLOG900 !
  367.  ELSE DLOG900 @ CALL BRINGTOFRONT DLOG900 @ CALL SHOWWINDOW THEN
  368.  OLDPORT   CALL GETPORT
  369.  DLOG900 @ CALL SETPORT      ( Set the dialog port )
  370.   BEGIN
  371.    0 DEVENT CALL MODALDIALOG ( Call this until the user has finished )
  372.   DEVENT W@ 4 < UNTIL
  373. OLDPORT @ CALL SETPORT       ( Reset "predialog" environment )
  374. DLOG900 @ 5 PAD PAD 4 + PAD 8 + CALL GETDITEM
  375. PAD 4 + @ TEDDY.F1 CALL GETITEXT         ( Set Teddy.F1 )
  376. DLOG900 @ 6 PAD PAD 4 + PAD 8 + CALL GETDITEM
  377. PAD 4 + @ TEDDY.F2 CALL GETITEXT         ( Set Teddy.F2 )
  378. DLOG900 @ CALL HIDEWINDOW
  379. TEDDY.T @ CALL TEACTIVATE
  380. TEDITMENU @ 7 CALL ENABLEITEM
  381. TEDDYFIND.SUB
  382. ;
  383. ( Handle Cut/Copy/Paste and others for Teddy and DAs )
  384. : TEDITHANDLER { ITEM }
  385.  CALL FRONTWINDOW TEDDY.W = IF ( Editor cut/paste )
  386. ITEM CASE
  387.      1 OF TEDDY.T @ CALL TECUT    MUSTCONVERT ON ENDOF
  388.      2 OF TEDDY.T @ CALL TECOPY   MUSTCONVERT ON ENDOF
  389.      3 OF TESCRAP.LEN W@
  390.           TEDDY.T @ @ 60 + W@
  391.           TEDDY.T @ @ 34 + W@ TEDDY.T @ @ 32 + W@ - -
  392.               + 32767 < IF
  393.            TEDDY.T @ CALL TEPASTE
  394.           ELSE 5 CALL SYSBEEP 5 CALL SYSBEEP THEN ENDOF
  395.      4 OF 0 TEDDY.T @ @ 60 + W@ TEDDY.T @ CALL TESETSELECT
  396.          TEDDY.T @ CALL TECOPY MUSTCONVERT ON ENDOF
  397.      6 OF TEDDYFIND                                ENDOF
  398.      7 OF TEDDYFIND.SUB                            ENDOF
  399.     ENDCASE
  400.     CORRECT.CONTROL.RANGE
  401.     CORRECTSCROLL
  402.     ELSE ( DA cut/copy/paste...Undo is left for you to add... )
  403.      CALL FRONTWINDOW
  404.      WINDOWKIND + W@ L_EXT 0< IF ITEM 4 < IF ITEM 1+ CALL SYSEDIT DROP THEN
  405.      THEN
  406.     THEN
  407. ;
  408.  
  409. ALSO ASSEMBLER
  410. ( Here we have support for SFGETFILE and SFPUTFILE these routines are
  411.   similar to the one in the Mach I manual. )
  412. HEADER TYPES    DC.B    'TEXT'
  413. HEADER GPROMPT  DC.B    20
  414.                 DC.B    'Please select a file'
  415. HEADER PPROMPT  DC.B    18
  416.                 DC.B    'Please type a name'
  417.  CODE TEDDYGETFILE
  418.     MOVE.W    #50,-(A7)
  419.     MOVE.W    #50,-(A7)
  420.     PEA        GPROMPT
  421.     CLR.L    -(A7)
  422.     MOVE.W    #1,-(A7)
  423.     PEA        TYPES
  424.     CLR.L    -(A7)
  425.     MOVE.L    (A6)+,-(A7)
  426.     MOVE.W    #2,-(A7)
  427.     _PACK3
  428.     RTS
  429. END-CODE
  430.  CODE TEDDYPUTFILE
  431.     MOVE.W    #50,-(A7)
  432.     MOVE.W    #50,-(A7)
  433.     PEA     PPROMPT
  434.     MOVE.L    (A6)+,-(A7)
  435.     CLR.L    -(A7)
  436.     MOVE.L    (A6)+,-(A7)
  437.     MOVE.W    #1,-(A7)
  438.     _PACK3
  439.     RTS
  440. END-CODE
  441. ONLY FORTH ALSO MAC 
  442. 230 USER PARMBLK
  443. CREATE FNAME 0 C, 63 ALLOT ( Our file has a name. This is where it is kept)
  444. CREATE FPLACE 0 ,          ( This is the folder of our file. HFS! )
  445. ( Here we some "dirty" programming. I use the file manager directly.
  446.   This works, but the code is not very clear. Once the PARaMeterBLocK
  447.   is set, it doesn't need to be changed much. Read Inside Macintosh 
  448.   for details on parameter blocks and the file system. )
  449. : TEDDYLOAD ( Replace selection range with a file )
  450.  TE->SCRAP
  451.  PAD TEDDYGETFILE ( Use PAD as SFREPLY )
  452.  PAD C@ IF  PAD 10 + FNAME 64 CMOVE
  453.             PAD 6  + W@ FPLACE !
  454.                        PARMBLK 12 + OFF
  455.             PAD 10 +   PARMBLK 18 + !
  456.             PAD 6 + W@ PARMBLK 22 + W!
  457.             0          PARMBLK 26 + W!
  458.                        PARMBLK 28 + OFF
  459.             PARMBLK CALL OPEN 
  460.              IF 10 CALL SYSBEEP ( Ouch! File Error )
  461.               ELSE
  462.               PARMBLK CALL GETEOF DROP
  463.               PARMBLK 28 + @
  464.               TEDDY.T @ @ 60 + W@
  465.               TEDDY.T @ @ 34 + W@ TEDDY.T @ @ 32 + W@ - -
  466.               + 32767 < ( Does the result fit? )
  467.                 IF TESCRAP.HANDLE @ DUP DUP
  468.                    PARMBLK 28 + @ CALL SETHANDLESIZE DROP
  469.                    CALL GETHANDLESIZE TESCRAP.LEN W!
  470.                    CALL HLOCK DROP
  471.                    TESCRAP.HANDLE @ @ PARMBLK 32 + !
  472.                    TESCRAP.LEN   W@   PARMBLK 36 + !
  473.                    0 PARMBLK 44 + W!
  474.                    0 PARMBLK 46 + !
  475.                    PARMBLK CALL READ DROP
  476.                    TESCRAP.HANDLE @ CALL HUNLOCK DROP
  477.                    PARMBLK CALL CLOSE DROP
  478.                    TEDDY.T @ CALL TEPASTE
  479.                    CORRECT.CONTROL.RANGE
  480.                    CORRECTSCROLL
  481.                 ELSE 5 CALL SYSBEEP 5 CALL SYSBEEP ( Ouch! Text too long )
  482.                 THEN
  483.             THEN
  484. THEN
  485. ;
  486. : TEDDYSAVE ( Save selection range )
  487.  TE->SCRAP
  488.  PAD FNAME TEDDYPUTFILE
  489.  PAD C@ IF  PAD 10 + FNAME 64 CMOVE
  490.             PAD 6  + W@ FPLACE !
  491.                        PARMBLK 12 + OFF
  492.             PAD 10 +   PARMBLK 18 + !
  493.             PAD 6 + W@ PARMBLK 22 + W!
  494.             0          PARMBLK 26 + W!
  495.                        PARMBLK 28 + OFF
  496.             PARMBLK CALL CREATE DROP
  497.             PARMBLK CALL OPEN   DROP
  498.             TEDDY.T @ @ 34 + W@ TEDDY.T @ @ 32 + W@ -
  499.             ?DUP 0= IF TEDDY.T @ @  60 + W@ THEN
  500.             PARMBLK 28 + !
  501.             PARMBLK CALL SETEOF DROP
  502.             TEDDY.T @ @ 34 + W@ TEDDY.T @ @ 32 + W@ -
  503.             ?DUP 0= IF
  504.               TEDDY.T @ @ 60 + W@ PARMBLK 36 + !
  505.               TEDDY.T @ @ 62 + @ @ PARMBLK 32 + !
  506.               ELSE 
  507.                                   PARMBLK 36 + !
  508.               TEDDY.T @ @ 62 + @ @ TEDDY.T @ @ 32 + W@ +
  509.                                   PARMBLK 32 + !
  510.               THEN
  511.              0 PARMBLK 44 + W! PARMBLK 46 + OFF
  512.              PARMBLK CALL WRITE  
  513.              PARMBLK CALL FLUSHFILE DROP
  514.              PARMBLK CALL CLOSE DROP
  515.               IF 10 CALL SYSBEEP
  516.                  PARMBLK CALL DELETE
  517.              ELSE 
  518.                  PARMBLK CALL GETFILEINFO DROP
  519.                  "TEXT PARMBLK 32 + ! ( Text files are of type TEXT! )
  520.                  "MACA PARMBLK 36 + ! ( We create MacWrite files )
  521.                  PARMBLK CALL SETFILEINFO DROP 
  522.              THEN
  523.              PARMBLK 18 + OFF
  524.              PARMBLK CALL FLUSHVOL DROP
  525.      THEN
  526. ;
  527. : TEDDYSAVEALL ( Save the whole file )
  528. TEDDY.T @ @ 60 + W@ IF
  529. TE->SCRAP
  530. FNAME C@ IF 
  531.                         PARMBLK 12 + OFF
  532.             FNAME      PARMBLK 18 + !
  533.             FPLACE @   PARMBLK 22 + W!
  534.             0          PARMBLK 26 + W!
  535.                        PARMBLK 28 + OFF
  536.             PARMBLK CALL CREATE DROP
  537.             PARMBLK CALL OPEN   DROP
  538.             TEDDY.T @ @  60 + W@ PARMBLK 28 + !
  539.             PARMBLK CALL SETEOF DROP
  540.               TEDDY.T @ @ 60 + W@ PARMBLK 36 + !
  541.               TEDDY.T @ @ 62 + @ @ PARMBLK 32 + !
  542.              0 PARMBLK 44 + W! PARMBLK 46 + OFF
  543.              PARMBLK CALL WRITE  
  544.              PARMBLK CALL FLUSHFILE DROP
  545.              PARMBLK CALL CLOSE DROP
  546.               IF 10 CALL SYSBEEP
  547.                  PARMBLK CALL DELETE
  548.              ELSE 
  549.                  PARMBLK CALL GETFILEINFO DROP
  550.                  "TEXT PARMBLK 32 + !
  551.                  "MACA PARMBLK 36 + ! 
  552.                  PARMBLK CALL SETFILEINFO DROP 
  553.              THEN
  554.              PARMBLK 18 + OFF
  555.              PARMBLK CALL FLUSHVOL DROP
  556.      THEN THEN
  557. ;
  558. : TFILEHANDLER ( Handle the file menu )
  559.  CASE 1 OF 0 TEDDY.T @ @ 60 + W@
  560.            TEDDY.T @ CALL TESETSELECT
  561.            TEDDYLOAD                ENDOF
  562.       2 OF TEDDYSAVEALL             ENDOF
  563.       3 OF TEDDY.T @ @ 32 + @
  564.            0 TEDDY.T @ @ 32 + !
  565.            TEDDYSAVE
  566.            TEDDY.T @ @ 32 + !       ENDOF
  567. ENDCASE
  568. ;
  569. : TEDDYMENUS ( Menu events are delivered here )
  570.  0 CALL HILITEMENU
  571.  CASE
  572.    APPLEID OF DAHANDLER         ENDOF
  573.    TFILEID OF TFILEHANDLER      ENDOF
  574.    TEDITID OF TEDITHANDLER      ENDOF
  575.   ENDCASE 
  576. ;
  577. ( This program has a menu on its window. There are 5 items on this menu
  578.   and the names of these items have to be somewhere. This was a simple
  579.   way to create an array of strings. )
  580. : TITLES
  581.  CASE 0 OF " Select All"      ENDOF
  582.       1 OF " Select Forward"  ENDOF
  583.       2 OF " Select Backward" ENDOF 
  584.       3 OF " Copy From Disk"  ENDOF
  585.       4 OF " Save Selection"  ENDOF ENDCASE
  586. ;
  587. : DRAWTITLES     ( Draw palette items )
  588. PAD CALL GETPORT  ( Get our window )
  589. PAD @ TXFONT + W@ ( Save text charasteristics )
  590. PAD @ TXSIZE + W@ 
  591. PAD @ TXMODE + W@
  592. 1 CALL TEXTFONT   ( Geneva )
  593. 9 CALL TEXTSIZE   ( 9 point )
  594. 1 CALL TEXTMODE
  595.  5 0 DO           ( 5 items in our palette )
  596.    2 I 90 * 2+ 15 OVER 91 + TEMR !RECT TEMR CALL ERASERECT
  597.                                        TEMR CALL FRAMERECT
  598.    I 90 * 47 +
  599.    I TITLES CALL STRINGWIDTH 2/ - ( Center the string )
  600.    12 CALL MOVETO I TITLES CALL DRAWSTRING
  601.  LOOP
  602.  CALL TEXTMODE ( Reset text charasteristics )
  603.  CALL TEXTSIZE      
  604.  CALL TEXTFONT
  605. ;
  606. 168 USER UPDATE-HOOK   ( Mach I has a lot of stupid hooks )
  607. 152 USER CONTENT-HOOK  ( I have to live with them )
  608. 172 USER ACTIVATE-HOOK ( even if I do not like them )
  609.  
  610. CREATE SPORT 4 ALLOT   ( Saved Port )
  611.  
  612. : GROWB ( Set the view rectangle )
  613.  TEDDY.W 20 + W@ 16 - 16 SCALE
  614.  TEDDY.W 22 + W@ 16 - + TEDDY.T @ @ 12 + !
  615. ;
  616. : TEDDYUP ( Update events are delivered here )
  617. ( Note that the zoom box also generates an update event! )
  618. SPORT CALL GETPORT    ( Save some external window )
  619.  TEDDY.W CALL SETPORT ( Use the text editor window for updates )
  620.  TEDDY.W CALL BEGINUPDATE ( Inside Mac says this must be done )
  621.  GROWB
  622.  TEDDY.W 16 + CALL ERASERECT ( Erase area to be updated )
  623.  DRAWTITLES                  ( Draw palette titles )
  624.  TEDDY.W 16 + TEDDY.T @ CALL TEUPDATE
  625.  TEDDY.W CALL DRAWCONTROLS   ( We have a scroll bar to update )
  626.  TEDDY.W CALL DRAWGROWICON
  627.  TEDDY.W CALL ENDUPDATE
  628. SPORT @ CALL SETPORT  ( Restore the port before the update )
  629. ;
  630. ( Given the number of the palette item that the mouse was pressed in,
  631.   this procedure tracks the mouse to see what the user really wants. )
  632. : DOPALETTE.SUB { SELECTED | SLOC }
  633.  3 SELECTED 90 * 3 + 14 OVER 89 + TEMR !RECT
  634.  0 -> SLOC
  635. BEGIN
  636.  CALL STILLDOWN
  637.  WHILE
  638.   @MOUSE TEMR CALL PTINRECT 0= 0= SLOC XOR
  639.    IF TEMR CALL INVERTRECT SLOC NOT -> SLOC THEN
  640.   REPEAT
  641. SLOC IF TEMR CALL INVERTRECT SELECTED 1+ ELSE 0 THEN
  642. ; 
  643. : DOPALETTE ( There is a mousedown in the palette )
  644.  @MOUSE L_EXT
  645.  2 - 90 / DOPALETTE.SUB
  646.   CASE 1 OF 0 TEDDY.T @ @ 60 + W@
  647.               TEDDY.T @ CALL TESETSELECT ENDOF
  648.        2 OF TEDDY.T @ @ 32 + W@ TEDDY.T @ @ 60 + W@
  649.             TEDDY.T @ CALL TESETSELECT ENDOF
  650.        3 OF 0 TEDDY.T @ @ 34 + W@
  651.             TEDDY.T @ CALL TESETSELECT ENDOF
  652.        4 OF TEDDYLOAD                  ENDOF
  653.        5 OF TEDDYSAVE                  ENDOF
  654. ENDCASE
  655. ;
  656. ( Dotextclick looks at the shift key and calls TeClick.
  657.   0= 0= is the equivalent of MacForth's "Boolean". )
  658. : DOTEXTCLICK ( MOUSEPT -- Click...no ammo in a mouse... )
  659.  EVENT-RECORD 14 + W@ 512 AND 0= 0= TEDDY.T @ CALL TECLICK
  660.  TEDDY.W CALL DRAWCONTROLS
  661. ;
  662.  
  663. 2 2 15 452 RECT BUTTONRECT ( This is the rect of our palette )
  664. : CONTENTCLICK { | MOUSEPT }
  665.  RUN-CONTENT
  666.  TEDDY.W CALL SETPORT
  667.  EVENT-RECORD 10 + @ PAD ! PAD CALL GLOBALTOLOCAL
  668.  PAD @ -> MOUSEPT MOUSEPT BUTTONRECT CALL PTINRECT
  669.     IF DOPALETTE 
  670.   ELSE MOUSEPT TEDDY.T @ @ 8 + CALL PTINRECT
  671.        IF MOUSEPT DOTEXTCLICK
  672.        THEN
  673.   THEN
  674. ;
  675. ( We set the dest and view rectangles )
  676. : INITTEXT
  677.  18 4 TEDDY.W 20 + W@ 16 - TEDDY.W 22 + W@ 16 - TEMR !RECT
  678.  TEMR PAD 8 CMOVE
  679.  1 PAD 2+ W! TEMR PAD CALL TENEW TEDDY.T !
  680.  -1 TEDDY.T @ @ 72 + W! 
  681. ;
  682. ( The following code handles the scroll bar )
  683. ( The thumb is called separately...Mach I manual for details )
  684. : DOTHUMB 
  685.  TEDDY.T @ @ W@ L_EXT 18 - NEGATE
  686.  TEDDY.SB @ CALL GETCTLVALUE 11 * -
  687.  0 SWAP TEDDY.T @ CALL TESCROLL
  688. ;
  689. : DOARROW 
  690.  TEDDY.SB @      CALL GETCTLVALUE SWAP OVER + 
  691.  TEDDY.SB @ SWAP CALL SETCTLVALUE
  692.  TEDDY.SB @      CALL GETCTLVALUE -
  693.   11 * 0 SWAP TEDDY.T @ CALL TESCROLL
  694. ;
  695. : TEDDYBAR
  696.  CASE 
  697.   UPARROW OF                      -1  DOARROW ENDOF
  698. DOWNARROW OF                       1  DOARROW ENDOF
  699.    PAGEUP OF TEDDY.W 20 + W@ 40 - -11 / -1 MIN DOARROW ENDOF
  700.  PAGEDOWN OF TEDDY.W 20 + W@ 40 -  11 /  1 MAX DOARROW ENDOF
  701. ENDCASE
  702. ;
  703. : TEDDYCONTROL  ( Control )
  704.  CASE ( In case of multiple controls... )
  705.   TEDDY.SB @ OF TEDDYBAR ENDOF
  706.  ENDCASE
  707. ;
  708. : TEDDYCONTROL2 ( Control/Part )
  709.  CASE ( In case of multiple controls and parts... )
  710.   TEDDY.SB @ OF  CASE THUMB  OF DOTHUMB ENDOF  ENDCASE  ENDOF
  711.  ENDCASE
  712. ;
  713. ( We go to sleep when we are not in use. Deactivate events look like
  714.  Activate events if the program doesn't look hard enough )
  715. : ACTIVATE-HANDLER
  716.     RUN-ACTIVATE
  717.     EVENT-RECORD 14 + W@ 1 AND 
  718.         IF WAKE STATUS TASK-> TEDDY.TASK W!
  719.            ACTIVE? ON
  720.            TEDDY.T @ CALL TEACTIVATE
  721.            SCRAP->TE
  722.       ELSE SLEEP STATUS TASK-> TEDDY.TASK W!
  723.            TEDDY.T @ CALL TEDEACTIVATE
  724.            ACTIVE? OFF
  725.            TE->SCRAP
  726.            CLEAR.TESCRAP
  727.       THEN
  728. ;
  729. ( The Enter key does indentation, return doesn't )
  730. : TEDDY.ENTER { | LOCATION CNTER NSPACES }
  731.  TEDDY.T @ @ 62 + @ @    -> LOCATION
  732.  TEDDY.T @ @ 32 + W@  1- -> CNTER
  733.  0 -> NSPACES
  734.  BEGIN
  735.   LOCATION CNTER + C@ 13 = NOT
  736.   CNTER 1+ 0> AND
  737.   WHILE
  738.    LOCATION CNTER + C@ 32 = IF NSPACES 1+ -> NSPACES 
  739.                             ELSE 0 -> NSPACES THEN
  740.    CNTER 1- -> CNTER
  741.   REPEAT
  742.  13 TEDDY.T @ CALL TEKEY
  743. NSPACES 0> IF
  744.  NSPACES 0 DO
  745.   32 TEDDY.T @ CALL TEKEY
  746.  LOOP THEN
  747. ;
  748. ( These are done only once, so we have a flag to show if the routine
  749.  must be called. Always Workspace before testing TEDDY or you will
  750.  save the flag in the wrong state! )
  751. CREATE CONFIGFLAG 0 ,
  752. : CONFIGURE.TEDDY
  753.  TEDDY.W ADD
  754.  TEDDY.W TEDDY.TASK BUILD
  755.  TEDDY.BAR ADD
  756.  TEDDY.BAR APPLEMENU ADD
  757.  TEDDY.BAR TFILE ADD
  758.  TEDDY.BAR TEDITMENU ADD
  759.  TEDDY.W TEDDY.SB ADD
  760.  INITTEXT
  761.  ADD.DRVRS
  762. TEDDY.BAR  TEDDY.TASK MBAR>TASK
  763. TEDDY.TASK 
  764.  CONFIGFLAG ON
  765. ;
  766. ( The following can be done the first time )
  767. : TEDDYGO
  768. CONFIGFLAG @ NOT IF CONFIGURE.TEDDY ACTIVATE THEN
  769.  ACTIVE? OFF
  770. ['] TEDDYMENUS       MENU-VECTOR    !
  771. ['] TEDDYUP          UPDATE-HOOK    !
  772. ['] CONTENTCLICK     CONTENT-HOOK   !
  773. ['] ACTIVATE-HANDLER ACTIVATE-HOOK  !
  774. ['] TEDDYCONTROL     TEDDY.SB 4 +   !
  775. ['] TEDDYCONTROL2    CONTROL-VECTOR !
  776. ['] CLICKPROC        TEDDY.T @ @ 42 + !
  777. 100 CURMAX ! CORRECT.CONTROL.RANGE
  778. TEDDY.SB @ ['] TEDDY.S2 !
  779. TEDDY.W    ['] TEDDY.W2 !
  780. TEDDY.T  @ ['] TEDDY.T2 !
  781. BEGIN       ( This is the beginning of our "Event" loop )
  782.  ACTIVE? @ IF TEDDY.T @ CALL TEIDLE ( Caret blink, blink, blink...)
  783.               ?TERMINAL ?DUP IF
  784.                 1 24 SCALE AND IF ( Is it a cmd key? )
  785.                   KEY CALL MENUKEY DROP
  786.                   ELSE
  787.                   KEY CASE
  788.                        3 OF TEDDY.ENTER                         ENDOF
  789.                        9 OF 4 0 DO 32 TEDDY.T @ CALL TEKEY LOOP ENDOF
  790.                        TEDDY.T @ CALL TEKEY 0 ( EndCase drops! )
  791.                        ENDCASE
  792.                   CORRECTSCROLL     ( Autoscrolling )
  793.                   CORRECT.CONTROL.RANGE
  794.                   CORRECT.CONTROL
  795.                   THEN
  796.                  THEN
  797.      THEN
  798.    PAUSE   ( This is the equivalent of GetNextEvent )
  799.    AGAIN
  800. ;
  801. : TED ( TED always starts the editor...even if you hide the window ) 
  802.  CONFIGFLAG @ NOT IF TEDDYGO THEN
  803.   TEDDY.W CALL SHOWWINDOW
  804.   TEDDY.W CALL SELECTWINDOW
  805.   TEDDY.BAR @ CALL SETMENUBAR
  806.   CALL DRAWMENUBAR
  807.   QUIT  
  808. ;
  809.